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-- file: PeepholeQ.mesa, edited by Sweet on August 29, 1978 11:60 AM 

DIRECTORY 

Code: FROM "code" USING [CodeNotlmplemented, CodePassInconsistancy, codeptr], 

CodeDefs: FROM "codedefs" USING [CCIndex, CCNull , ChunkBase, CodeCCIndex, JumpCCIndex, JumpType, NULL 
**f ileindex] , 

ComData: FROM "comdata" USING [dStar], 

ControlDefs: FROM "controldef s" USING [codebaseOff set] , 

FOpCodes: FROM "fopcodes" USING [qADD. qAND, qBCAST, qBCASTL, qBLT, qBLTC. qBLTCL, qBLTL, qDADD, qDBL 
**, qDEC, qDESCB, qDESCBS, qDUP, qDWDC, qEFC. qEXCH. qFDESCBS, qGADRB, qlNC. qlWDC, qKFCB, qLADRB, qLG, 
** qLGD, qLI, qLINKB. qLINT, qLL. qLLD, qLLK, qLP, qME , qMEL, qMRE , qMREL. qMUL, qMXD, qMXDL, qMXW, qMX 
**WL, qNEG, qNOOP, qNOTIFY. qNOTIFYL, qOR, qPOP, qPUSH. qR, qRD. qRDL. qREQUEUE, qREQUEUEL, qRF, qRFL, 
**qRFS, qRFSL, qRIG. qRIGL. qRIL. qRILF, qRILL. qRL. qRSTR. qRSTRL. qRXG, qRXGL, qRXL, qRXLL, qSDIV, qS 
**FC. qSG, qSGD, qSHIFT, qSL. qSLD, qSUB, qW, qWD, qWDL, qWF, qWFL, qWIG, qWIGL, qWIL, qWILL, qWL, qWS, 
** qWSD, qWSF. qWSTR, qWSTRL, qWXG. qWXGL, qWXL, qWXLL, qXOR], 

InlineDefs: FROM "inlinedefs" USING [BITAND, BITSHIFT], 

OpCodeParams: FROM "opcodeparams" USING [BYTE, GlobalHB, HB, LocalBase, LocalHB], 

P5ADefs: FROM "p5adefs" USING [deletecell, PopEffect, PushEffect], 

P5BDefs: FROM "pSbdefs" USING [CO, CI. C2, LoadConstant] , 

PeepholeDefs: FROM "peepholedefs" USING [cpeepz, de1ete2, deletes, HalfByteLocal , InitJParametersBC, 
**InitParametersABC, InitParametersBC, InitParametersC , JumpPeepState. Loadlnst, MCO, PeepholeUNotify. 
**Peepho1eZNotify, PeepState, SetReallnst, SetSourcelndex, 31 idePeepStatel, SI idePeepState2, UnpackFD],- 

SDDefs: FROM "sddefs" USING [sBLTE. sBLTEC. sBLTECL, sBLTEL. sBYTBLTE. sBYTBLTEC, sBYTBLTECL, sBYTBLT 
**EL, sDivSS], 

TableDefs: FROM "tabledefs" USING [TableNotif ier] , 
TreeDefs: FROM "treedefs" USING [treetype]; 

PeepholeQ: PROGRAM 

IMPORTS CPtr: Code, MPtr: ComData, P5ADefs, P5BDefs, PeepholeDefs 

EXPORTS CodeDefs, P5BDefs = 

BEGIN OPEN PSADefs, PSBDefs, PeepholeDefs, OpCodeParams, CodeDefs; 

-- imported definitions 

BYTE: TYPE = JpCodeParams .BYTE ; 
qNOOP: BYTE = FOpCodes . qNOOP; 
CodeCCIndex: TYPE = CodeDefs .CodeCCIndex; 
JumpCCIndex: TYPE = CodeDefs . JumpCCIndex; 

cb: ChunkBase; -- code base (local copy) 

RJump: ARRAY JumpType[JumpE . .UJumpLE] OF JumpType « [ 
JumpE, JumpN, JumpG, JumpLE, JumpL, JumpGE, 
UJumpG, UJumpLE, UJumpL, UJumpGE]; 

dummyProc: PROCEDURE « 

BEGIN -- every 2 minutes of compile time helps 

s: PeepState; 

js: JumpPeepState; 

IF FALSE THEN [] ♦- s; 

IF FALSE THEN [] ♦- js; 

END; 

PeepholeNotify: PUBLIC TableDefs .TableNotif ier « 

BEGIN -- called by allocator whenever table area is repacked 

cb ^ LOOPHOLE[base[TreeDefs. treetype]]; 

PeepholeZNoti fy[base]; 

PeepholeUNotify[base]; 

RETURN 

END; 

start: CodeCCIndex; 

Cpeephole: PUBLIC PROCEDURE [s: CCIndex] « 
BEGIN 

start *- LOOPHOLE[s]; 
SetRealInst[FALSE]; 
IF -MPtr.dStar THEN RemoveLongs[] ; 
cpeepO[]; 
cpeepl[]; 
cpeep2[]; 
cpeep3[]; 
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cpeep4[]; 
cpeep5[]; 
cp8ep6[]; 
cpeep7[]; 

SetReaHnst[TRUE]; 
cpeepz[start]; 

SetSourceIndex[NULLf ileindexJ.- 
END; 

RemoveLongs: PROCEDURE » 

BEGIN -- remove long instructions 
OPEN FOpCodes; 
next: CodeCCIndex; 
state: PeepState; 
newinst: BYTE; 

BEGIN OPEN state; 
next <- start; 

UNTIL (c ^ next) = CCNull DO 
next ^ LOOPHOLE[cb[c].flink]; 
newinst ♦- qNOOP; 

WITH cb[LOOPHOLE[c,CCIndex]] SELECT FROM 
code «> 
BEGIN 

InitParametersC[0state]; 
SELECT cinst FROM 

qRL => BEGIN newinst ^ qR; GOTO popO END; 

qRDL => BEGIN newinst ^ qRD; GOTO popO END; 

qRFL => BEGIN newinst ^ qRF; GOTO popO END; 

qWL => BEGIN newinst <- qW; GOTO popO END; 

qWFL => BEGIN newinst ^ qWF ; GOTO popO END; 

qRFSL => BEGIN newinst <- qRFS; GOTO popl END; 

qRSTRL => BEGIN newinst *- qRSTR; GOTO popl END; 

qWDL => BEGIN newinst ^ qWD; GOTO popO END; 

qWSTRL => BEGIN newinst <- qWSTR; GOTO popl END; 

qRXLL => newinst ^ qRXL; 

qWXLL => newinst ^ qWXL; 

qRXGL => newinst <- qRXG; 

qWXGL => newinst ^ qWXG; 

qRILL => newinst ^ qRIL; 

qWILL => newinst <- qWIL; 

qRIGL «> newinst ^ qRIG; 

qWIGL => newinst <~ qWIG; 

qBLTCL => BEGIN newinst *- qBLTC; GOTO popO END; 

qBLTL => BEGIN newinst *- qBLT; InsertPOP[0] ; GOTO pop2 END; 

qMEL => BEGIN newinst ^ qME; GOTO popO END; 

qMREL => BEGIN newinst <- qMRE; InsertPOP[0] ; GOTO popl END; 

qMXWL => BEGIN newinst <- qMXW; InsertPOP[l] ; GOTO pop2 END; 

qMXDL => BEGIN newinst <- qMXD; GOTO popO END; 

qNOTIFYL => BEGIN newinst <- qNOTIFY; GOTO popO END; 

qBCASTL => BEGIN newinst <- qBCAST; GOTO popO END; 

qREQUEUEL => BEGIN newinst *- qREQUEUE; InsertPOP[l] ; GOTO pop2 END; 

qKFCB => 

BEGIN OPEN SDDefs; 
newpl: WORD; 
SELECT cpCl] FROM 

sBLTEL => BEGIN newpl <- sBLTE; InsertPOP[03 END; 
sBYTBLTEL ==> BEGIN newpl *- sBYTBLTE; InsertPOPCO] END; 
sBLTECL => newpl ^ sBLTEC; 
sBYTBLTECL => newpl ♦- sBYTBLTEC; 
ENDCASE => GO TO notspecial; 
cb[c].parameters[l] ♦- newpl; 



GO TO pop2; 




EXITS notspecial => NULL; 




END; 




ENDCASE; 




EXITS 




popO »> InsertPOP[0]; 




popl => InsertPOP[l]; 




pop2 »> InsertP0P[2]; 




END; 




ENDCASE; -- of WITH 




IF newinst ff qNOOP THEN cb[c].inst ^ newinst; 


ENDLOOP; 




END; -~ of OPEN 




RETURN 
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END; 

BackupCP: PROCEDURE [n: INTEGER] RETURNS [INTEGER] - 

BEGIN OPEN FOpCodes; -- back up codeptr n stack positions 
cc: CCIndex <- CPtr .codeptr; 
neteffect: INTEGER; 

WHILE (cc *- cb[cc]. blink) # CCNull AND n j^ DO 
WITH cb[cc] SELECT FROM 
code "> 
BEGIN 

neteffect <- PushEffect[inst] - PopEf fect[inst]; 
IF n-neteffect < THEN EXIT; 
n <- n - neteffect; 
END; 
ENDCASE «> EXIT; 
ENDLOOP; 
CPtr. codeptr <- cc; 
RETURN[n] 
END; 

InsertPOP: PROCEDURE [n: INTEGER] » 

BEGIN OPEN FOpCodes; -- insert (or simulate) a POP of the word at tos-n 
savecodeptr: CCIndex *■ CPtr .codeptr; 
n ^ BackupCP[n]; 
SELECT n FROM 

=> C0[qPOP]; 

1 => BEGIN COiqEXCH]; C0[qPOP] END; 

2 => BEGIN C0[qPOP]; CO[qEXCH]; CO[qPUSH]; CO[qEXCH]; C0[qPOP] END; 

3 => BEGIN C0[qPOP]; C0[qPOP]; CO[qEXCH]; CO[qPUSH]; CO[qEXCH]; COCqPUSH]; CO[qEXCH]; C0[qPOP] EN 
*D; 

ENDCASE => SIGNAL CPtr .CodePassInconsistancy ; 
CPtr. codeptr <- savecodeptr; 
RETURN 
END; 

- from hybrid compiler 

- ConvertBLTC: PROCEDURE [longdest: BOOLEAN] = 

BEGIN OPEN FOpCodes; 

savecodeptr: CCIndex <- CPtr .codeptr ; 

IF BackupCP[IF longdest THEN 3 ELSE 2]#0 THEN 

SIGNAL CPtr .CodePassInconsistancy ; 
IF longdest THEN LoadConstant[0]; 
CO[qIWDC]; 

Cl[qLG, ControlDefs.codebaseOffset]; 
IF longdest THEN CO[qLP]; 

MCO[(IF longdest THEN qDADD ELSE qADD) , TRUE]; 
CPtr. codeptr <- savecodeptr; 
CO[qDWDC]; 
RETURN 
END; 

ConvertBLTC: PROCEDURE [longdest: BOOLEAN] » 
BEGIN OPEN FOpCodes; 
savecodeptr: CCIndex *- CPtr .codeptr ; 
IF BackupCP[IF longdest THEN 3 ELSE 2]#0 THEN 

SIGNAL CPtr .CodePassInconsistancy; 
IF MPtr.dStar THEN 

BEGIN 

LoadConstant[0]; 

Cl[qLGD, ControlDefs.codebaseOffset]; 

COfqDADD]; 

END 
ELSE 

BEGIN 

CO[qIWDC]; 

Cl[qLG, ControlDefs.codebaseOffset]; 

MCO[qADD, TRUE]; 

END; 
IF MPtr.dStar AND --longdest THEN 

BEGIN 

CPtr. codeptr ^ savecodeptr; 

[] ^ BackupCP[0]; 

CO[qLP]; 

END; 
CPtr. codeptr ♦- savecodeptr; 
IF -MPtr.dStar THEN C0[qDWOC]; 
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RETURN 
END; 

cpeepO: PROCEDURE ■ 

BEGIN -- undo doubles, undo BLTC 
OPEN FOpCodes; 
next: CodeCCIndex; 
state: PeepState; 

next ♦■ start; 
BEGIN OPEN state; 
UNTIL (c *- next) » CCNull DO 
next ^ L00PH0LE[cb[c].f1ink]; 
WITH cb[LOOPHOLE[c.CCIndex]] SELECT FROM 
code => 
BEGIN 

InitParametersC[6state]; 
SELECT cinst FROM 
qLGD «> 

BEGIN inst ^ qLG; Cl[qLG, cp[l]+l]; END; 
qLLD »> 

BEGIN inst ^ qLL; Cl[qLL, cp[l]+l]; END; 
qBLTCL «=> 

BEGIN inst <- qBLTL; ConvertBLTC[TRUE] ; END; 
ENDCASE; 
END; 
ENDCASE; -~ of WITH 
ENDLOOP; 
END; -- of OPEN state 
RETURN 
END; 

cpeepl: PROCEDURE « 

BEGIN -- remove POPs by modifying previous instruction 

OPEN FOpCodes; 

next, ci: CCIndex; 

state: PeepState; 

didsomething: BOOLEAN ♦- TRUE; 

canSlide: BOOLEAN ^ FALSE; 

WHILE didsomething DO 
OPEN state; 
next ♦- start; 
didsomething ♦- FALSE; 
UNTIL (ci ^ next) = CCNull DO 
next *- cb[ci] .f 1 ink; 
WITH cb[ci] SELECT FROM 
code => 
BEGIN 

didThisTime: BOOLEAN *- FALSE; 

IF canSlide THEN SI idePeepState2[@state. LOOPH0LE[ci]3 
ELSE 
BEGIN 

c *- LOOPHOLE[ci]; 
InitParametersABC[0state]; 
END; 
canSlide «- FALSE; 
SELECT cinst FROM 
qPOP »> 

IF POPable[binst] THEN 
BEGIN 

deletecell[b]; 
deletecel l[c]; 
didThisTime <- TRUE; 
END 
ELSE 

SELECT binst FROM 

qR, qRF, qRXL, qNEG. qDESCBS, qlNC. qDEC «> 
BEGIN 

deletecell[b]; 
didThisTime <- TRUE; 
END; 
qDADD -> 

IF POPable[ainst] THEN 
BEGIN 
delete2[a,b]; 
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InsertPOP[l]; 
MCO[qADD, bmin]; 
deletecel l[c]; 
didThisTime ^ TRUE; 
END; 
qRD «> 
BEGIN 

cb[b] . inst ♦• qR; 
deletecel 1[c]; 
didThisTime ^ TRUE; 
END; 
qlWDC, qDWDC «> 
BEGIN 

CommuteCen s[b,c] ; 
didThisTime <- TRUE; 
END; 
ENDCASE; 
ENDCASE; 
didsomething <- didsomething OR didThisTime; 
canSlide <- -didThisTime; 
END; 
ENDCASE => canSlide ^ FALSE; -- of WITH 
ENDLOOP; 
ENDLOOP; 
RETURN 
END; 

POPable: PROCEDURE [inst: BYTE] RETURNS [BOOLEAN] » 
BEGIN OPEN FOpCodes; 
RETURN[instj5'qN00P AND 

(PopEffect[inst]=0 AND PushEf f ect[inst]=l OR inst = qLP OR inst « qDUP)] 
END; 

cpeep2: PROCEDURE « 

BEGIN -- expand families 
OPEN FOpCodes; 
next, ci: CCIndex; 
state: PeepState; 
canSlide: BOOLEAN ♦■ FALSE; 

next <- start; 
BEGIN OPEN state; 
UNTIL (ci ♦- next) = CCNull DO 
next ^ cb[ci].f 1 ink; 
WITH cb[ci] SELECT FROM 
code «> 
BEGIN 

IF canSlide THEN SI idePeepState2[@state, LOOPHOLE[ci]] 
ELSE 
BEGIN 

c ♦- LOOPHOLE[ci]; 
InitParametersABC[@state]; 
END; 
canSlide <- FALSE; 
SELECT cinst FROM 

-- expand out-of-range families 
qRIG «> 

IF cp[l] -IN GlobalHB OR cp[2] -IN HB THEN 

BEGIN Cl[qLG. cp[l]]; Cl[qR. cp[2]]; deletecel! [c] ; END; 
qRIL «> 

IF cp[l] -IN LocalHB OR cp[2] -IN HB THEN 

BEGIN Cl[qLL, cp[l]]; Cl[qR. cp[2]]; deletecel l[c] ; END; 
qRXL «> 

IF cp[l] -IN LocalHB OR cp[2] -IN HB THEN 

BEGIN Cl[qLL, cp[l]]; MCO[qADD. cmin]; Cl[qR. cp[2]]; deletecel 1 [c] ; END; 
qWXL -> 

IF cp[l] -IN LocalHB OR cp[2] -IN HB THEN 

BEGIN Cl[qLL, cp[l]]; CO[qADD]; Cl[qW. cp[2]]; deletecel 1 [c] ; END; 
qWIL «> 

IF cp[l] -IN LocalHB OR cp[2] -IN HB THEN 

BEGIN Cl[qLL, cp[l]]; Cl[qW. cp[2]]; deletecel l[c] ; END; 
qRXG -> 

IF TRUE THEN 

BEGIN Cl[qLG, cp[l]]; MCO[qADD, cmin]; Cl[qR, cp[2]]; deletecel l[c]; END; 
qWXG -> 

IF TRUE THEN 
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BEGIN Cl[qLG, cp[l]]; CO[qADD]; Cl[qW, cp[2]]: deletecell [c] ; END; 
qWIG "> 

IF TRUE THEN 

BEGIN Cl[qLG, cp[l]]; Cl[qW, cp[23]: deletecell [c] ; END; 
qRIGL -> 

IF cp[l] -IN GlobalHB OR cp[2] -IN HB THEN 

BEGIN Cl[qLGD, cp[l]]; Cl[qRL, cp[2]]; deletecell [c]; END; 
qRILL »> 

IF cp[l] -IN LocalHB OR cp[23 -IN HB THEN 

BEGIN Cl[qLLD, cp[133; Cl[qRL. cp[233; deletecell [c3; END; 
qRXLL «> 

IF cp[13 -IN LocalHB OR cp[23 -IN HB THEN 

BEGIN LoadConstant[03; Cl[qLLD, cp[133; C0[qDADD3; Cl[qRL. cp[233; deletecel 1 [c3 ; END; 
qWXLL »> 

IF cp[l3 -IN LocalHB OR cp[23 -IN HB THEN 

BEGIN LoadConstant[03; Cl[qLLD. cpCl33; C0[qDADD3; Cl[qWL, cp[233; deletecel 1 [c3 ; END; 
qWILL «> 

IF cp[13 -IN LocalHB OR cp[23 -IN HB THEN 

BEGIN Cl[qLLD. cp[l33; Cl[qWL, cp[233; deletecel 1 [c3; END; 
qRXGL «> 

IF cp[l3 -IN GlobalHB OR cp[23 -IN HB THEN 

BEGIN LoadConstant[03; ClfqLGD, cp[133; C0[qDADD3; Cl[qRL, cp[233; deletecel 1 [c3 ; END; 
qWXGL »> 

IF cp[13 -IN GlobalHB OR cp[23 -IN HB THEN 

BEGIN LoadConstant[03; ClfqLGD, cp[133; C0[qDADD3; Cl[qWL, cp[233; del etecel 1 [c3 ; END; 
qWIGL => 

IF cp[13 -IN GlobalHB OR cp[23 -IN HB THEN 

BEGIN Cl[qLGD, cp[133; Cl[qWL, cp[233; deletecel 1 [c3 ; END; 
qRILF => 

IF TRUE THEN 

BEGIN Cl[qLL. cp[133; C2[qRF, cp[23, cp[333; del etecel 1 [c3 ; END; 
qEFC, qLLK => 

IF cp[l3 -IN BYTE THEN 

SIGNAL CPtr.CodeNotlmplemented; 
qLINKB => 

IF TRUE THEN 
BEGIN 

LoadConstant[cp[133 * 
C0[qSUB3; Cl[qSL, LocalBase3; 
END; 
qDESCBS, qDESCB, qFDESCBS => 
BEGIN 
IF cp[13/2 -IN BYTE OR cp[13 MOD 2 = THEN 

SIGNAL CPtr.CodeNotlmplemented; 
parameters[l3 *- cp[13/2; 
IF cinst = qFDESCBS THEN 

BEGIN inst <- qDESCBS; C0[qSFC3; END; 
END; 
qSDIV «> 
BEGIN 

Cl[qKFCB, SDDefs.sDivSS3r 
deletecell[c3; 
END; 
qDEC => IF cmin THEN 

BEGIN LoadConstant[-l3; MC0[qAOD. TRUE3; deletecel l[c3 END 
ELSE BEGIN LoadConstant[13 ; C0[qSUB3; deletecen[c3 END; 
qLINT => 
BEGIN 
C0[qOUP3; 

LoadConstant[-153; 
C0[qSHIFT3; 
C0[qNEG3; 
deletecen[c3; 
END; 
qGADRB, qLADRB «> 

IF cp[13 -IN BYTE THEN 
BEGIN 

parameters[13 *- LASr[BYTE3; 

LoadConstant[cp[l3~LAST[BYTE33; MCO[qADD, cmin3; 
END; 
-- discover family members from sequences 
qR «> 

IF cp[l3 IN HB THEN 
SELECT binst FROM 
qADD «> 

IF HalfByteLocal[a3 THEN 
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BEGIN C2[qRXL. ap[l]. cp[l]]; delete3[a,b ,c] ; END; 
qLL ■> 

IF bp[l] IN LocalHB THEN 

BEGIN C2[qRIL. bp[l]. cp[l]]; d8lete2[b , c] ; END; 
qLG -> 

IF bp[l] IN GlobalHB THEN 

BEGIN C2[qRIG, bp[l], cp[l]]; clelete2[b, c] ; END; 
ENDCASE; 
qW »> 

IF cp[l] IN HB THEN 
SELECT binst FROM 
qADD -> 

IF HalfByteLoca1[a] THEN 

BEGIN C2[qWXL, ap[l], cp[13]; del ete3[a,b .c] ; END; 
qLL «> 

IF bp[l] IN LocalHB THEN 

BEGIN C2[qWIL, bp[l], cp[l]]; de1ete2[b,c]; END; 
ENDCASE; 
ENDCASE «> canSlide <- TRUE; 
END; 
ENDCASE => canSlide ^ FALSE; ~- of WITH 
ENDLOOP; 
END; -- of OPEN state 
RETURN 
END; 

cpeep3: PROCEDURE « 
BEGIN -- sprinkle DUPs 
OPEN FOpCodes; 
next, ci: CCIndex; 
state: PeepState; 
canSlide: BOOLEAN ^ FALSE; 

next *- start; 
BEGIN OPEN state; 
UNTIL (ci <- next) = CCNull DO 
next <- cb[ci].f 1 ink; 
WITH cb[ci] SELECT FROM 
code => 
BEGIN 

IF canSlide THEN SI idePeepState2[@state . LOOPHOLE[ci]] 
ELSE 
BEGIN 

c ^ L00PH0LE[ci3; 
In itParametersABC[ estate]; 
END; 
canSlide ♦- FALSE; 
SELECT cinst FROM 

-- replace loadjoad with load,DUP 
qLL, qLG, qLI => 

IF binst - cinst AND cp[l] = bp[l] THEN 
BEGIN CO[qDUP]; deletecel 1 [c] END; 
qRIL, qRIG, qRILL, qRIGL -> 

IF binst = cinst AND cp[l] = bp[l] AND cp[2] = bp[2] THEN 
BEGIN CO[qDUP]; deletecen[c] END; 
ENDCASE => canSlide <- TRUE; 
END; 
ENDCASE => canSlide ^ FALSE; -- of WITH 
ENDLOOP; 
END; — of OPEN state 
RETURN 
END; 

cpeep4: PROCEDURE « 

BEGIN -- PUTS and PUSHs. RF and WF to RSTR and WSTR 

OPEN FOpCodes; 

next, ci: CCIndex; 

state: PeepState; 

pos, size: [0. .16) ; 

canSlide: BOOLEAN ^ FALSE; 

next <- start; 
BEGIN OPEN state; 
UNTIL (ci ^ next) « CCNull DO 
next +- cb[ci] . f 1 ink; 
WITH cb[ci] SELECT FROM 
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code "> 
BEGIN 

IF canSlide THEN SI idePeepState2[0state, LOOPHOLE[ci]] 
ELSE 
BEGIN 

c *- LOOPHOLE[ci]; 
InitParametersABC[@state]; 
END; 
canSlide <- FALSE; 
SELECT cinst FROM 
qLL "> 

IF binst « qSL AND cp[l] » bp[l] THEN 
BEGIN CO[qPUSH]; deletecell [c] ; END 
ELSE GO TO Slide; 
qLG -> 

IF binst « qSG AND cp[l] » bp[l] THEN 
BEGIN COCqPUSH]; deletecel 1 [c] ; END 
ELSE GO TO Slide; 
qRIL =»> 

IF binst = qWIL AND cp[l] = bp[l] AND cpC2] « bp[2] THEN 

BEGIN CO[qPUSH]; deletecel 1 [c] END 
ELSE GO TO Slide; 
qRILL «> 

IF binst = qWILL AND cp[l] = bp[l] AND cp[2] « bp[2] THEN 

BEGIN CO[qPUSH]; deletecel 1 [c] END 
ELSE GO TO Slide; 
qRIGL => 

IF binst = qWIGL AND cp[l] = bp[l] AND cp[2] = bp[2] THEN 

BEGIN CO[qPUSH]; deletecel 1 [c] END 
ELSE GO TO Slide; 
qRF. qWF, qRFL, qWFL «> 
BEGIN 

[pos. size] *- UnpackFD[L00PH0LE[cp[2]]]; 
IF size = 8 AND cp[l] <= LAST[BYTE]/2 THEN 
SELECT pos FROM 
0, 8 => 
BEGIN 

LoadConstant[0]; 
C1[(SELECT cinst FROM 
qRF => qRSTR, 
qWF => qWSTR. 
qRFL => qRSTRL. 

ENDCASE => qWSTRL), cp[l]*2+pos/8] ; 
deletecen[c]; 
END; 
ENDCASE => GO TO Slide 
ELSE GO TO Slide; 
END; 
ENDCASE => GO TO Slide; 
EXITS 

Slide => canSlide *- TRUE; 
END; 
ENDCASE => canSlide «- FALSE; -- of WITH 
ENDLOOP; 
END; -- of OPEN state 
RETURN 
END; 

NonWS: ARRAY [FOpCodes . qWS. . FOpCodes . qWSD] OF BYTE « 

[FOpCodes.qW, FOpCodes .qWF , FOpCodes .qWD] ; 

cpeep5: PROCEDURE " 

BEGIN -- put doubles back, eliminate EXCH preceding commutative operator 
OPEN FOpCodes; 
next, ci: CCIndex; 
state: PeepState; 
canSlide: BOOLEAN *- FALSE; 

next *- start; 
BEGIN OPEN state; 
UNTIL (ci *- next) « CCNull DO 
next <- cb[ci].f link; 
WITH cc:cb[ci] SELECT FROM 
code «> 
BEGIN 
IF canSlide THEN SI idePeepState2[0state, LOOPHOLE[ci]] 
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ELSE 
BEGIN 

c ^ LOOPHOLE[ci]; 
InitParametersABC[@state]; 
END; 
canSl ide ^ FALSE; 
SELECT cinst FROM 
qLL => 

IF binst - qLL AND cp[l] « bp[l]+l THEN 

BEGIN cb[b].inst ^ qLLD; de letecell [c] ; END 
ELSE GO TO Slide; 
qSL -> 

IF binst - qSL AND cp[l] - bp[l]-l THEN 

BEGIN cb[c].inst ^ qSLD; deletecell [b] ; END 
ELSE GO TO Slide; 
qLG => 

IF binst « qLG AND cp[l] -= bpCl]+l THEN 

BEGIN cb[b].inst *- qLGD; deletecen[c] ; END 
ELSE GO TO Slide; 
qSG => 

IF binst = qSG AND cp[l] = bp[l]-l THEN 

BEGIN cb[c].inst ♦- qSGD; deletecel 1 [b] ; END 
ELSE GO TO Slide; 
qADD. qMUL. qAND, qOR. qXOR «> 

IF binst = qEXCH THEN deletecel 1 [b] 
ELSE GO TO Slide; 
qWS. qWSF, qWSD «> 

IF binst - qEXCH THEN 

BEGIN deletecen[b]: cc.inst ^ NonWS[cinst]; END 
ELSE GO TO Slide; 
qEXCH «> 

IF binst = qEXCH THEN delete2[b.c] 
ELSE IF LoadInst[b] AND LoadInst[a] THEN 
BEGIN 

deletecel l[c]; 
CommuteCens[a,b]; 
cb[a] .minimalStack *- bmin; 
cb[b].mininialStack *- amin; 
END 
ELSE GO TO Slide; 
ENDCASE => GO TO Slide; 
EXITS 

Slide => canSlide *- TRUE; 
END; 
jump a> 
BEGIN 

canSlide ^ FALSE; 

IF cc.jtype IN [JumpE . .UJumpLE] THEN 
WITH cb[cc. blink] SELECT FROM 

code => IF -realinst AND inst = qEXCH AND 

-PushFollowsCLOOPHOLECci.JumpCCIndex]] THEN 
BEGIN deletecel l[cc.bl ink] ; cc.jtype ♦- RJump[cc. jtype] ; END; 
ENDCASE; 
END; 
ENDCASE => canSlide ♦- FALSE; -- of WITH 
ENDLOOP; 
END; -- of OPEN state 
RETURN 
END; 

PushFollows: PROCEDURE [c: JumpCCIndex] RETURNS [BOOLEAN] « 

BEGIN -- c is conditional jump; TRUE if PUSH follows on either branch 
next: CCIndex; 

FOR next <- cb[c].flink, cb[next] . f 1 ink WHILE next ^ CCNull DO 
WITH cb[next] SELECT FROM 

code => IF -real inst AND inst « FOpCodes .qPUSH THEN RETURN[TRUE] 

ELSE EXIT; 
label => NULL; 
ENDCASE «> EXIT; 
ENDLOOP; 
IF (next*-cb[cb[c].destlabel].flink) ff CCNull THEN 
WITH cb[next] SELECT FROM 

code "> IF -realinst AND inst « FOpCodes .qPUSH THEN RETURN[TRUE]; 
ENDCASE; 
RETURN[FALSE] 
END; 
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CommuteCens: PROCEDURE [a, b: CCIndex] ■ 
BEGIN 

prev, next: CCIndex; 
prev ^ cb[a]. blink; -- never Null 
next ♦- cb[b] .f 1 ink; 
cb[prev].f1ink ♦- b; 
cb[b]. blink <- prev; 
cbCb].flink ^ a; 
cb[a]. blink ♦- b; 
cb[a3.f 1 ink ^ next; 

IF next ^ CCNull THEN cb[next]. bl ink 4- a; 
RETURN 
END; 

cpeep6: PROCEDURE » 

BEGIN -- store double/load double. INC and DEC, MUL to SHIFT etc 

OPEN FOpCodes; 

next, ci: CCIndex; 

canSlide: BOOLEAN ♦- FALSE; 

state: PeepState; 

negate, powerof2: BOOLEAN; 

log: CARDINAL; 

d2: PROCEDURE » 

BEGIN 

delete2[state.b, state. c]; 

IF negate THEN CO[qNEG]; 

RETURN 

END; 



next <- start; 
BEGIN OPEN state; 
UNTIL (ci <- next) = CCNull DO 
next <- cb[ci].f link; 
WITH cb[ci] SELECT FROM 
code => 
BEGIN 

IF canSlide THEN SI idePeepStatel[@state, LOOPH0LE[ci]] 
ELSE 
BEGIN 

c <- LOOPHOLE[ci]; 
InitParametersBC[0state]; 
END; 
canSlide ^ FALSE; 
SELECT cinst FROM 
qLLD «> 

IF binst = qSLD AND cp[l] = bp[l] THEN 

BEGIN CO[qPUSH]; CO[qPUSH]; deletecel 1 [c] END 
ELSE GO TO Slide; 
qLGD => 

IF binst = qSGD AND cp[l] = bp[l] THEN 

BEGIN CO[qPUSH]; CO[qPUSH]; deletecel 1 [c] END 
ELSE GO TO Slide; 
qADD, qSUB => 

IF binst = qLI THEN 
BEGIN 
SELECT LOOPHOLE[bp[l], INTEGER] FROM 

«> delete2[b,c]; 

1 «> IF cinst = qADD THEN 

BEGIN cb[c].inst ^ qINC; deletecel 1 [b] ; END; 
-1 «> IF cinst = qSUB THEN 

BEGIN cb[c].inst <- qINC; deletecel l[b]; END; 
ENDCASE => GO TO Slide; 
END 
ELSE IF binst - qNEG THEN 
BEGIN 

cb[c].inst <- IF cinst = qADD THEN qSUB ELSE qADD; 
deletecell[b]; 
END 
ELSE GO TO Slide; 
qSHIFT »> 

IF binst « qLI THEN 
SELECT bp[l] FROM 

1 «> BEGIN cb[c].inst <~ qDBL; deletecel l[b] END; 
-> delete2[b,c3; 
ENDCASE «> GO TO Slide 
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ELSE 60 TO Slide; 
qMUL -> 

IF binst » qLI THEN 
BEGIN 

negate <- FALSE; 
IF LOOPHOLE[bpCl], INTEGER] < THEN 

BEGIN negate ^ TRUE; bp[l] *- -LOOPHOLE[bp[l] , INTEGER]; END; 
SELECT bp[l] FROM 

1 «> cl2[]; 

2 => BEGIN CO[qDBL]; d2[]; END; 

3 «> BEGIN CO[qDUP]; CO[qDBL]; MCO[qADD. cmin]; d2[]; END; 

4 => BEGIN CO[qDBL]; CO[qDBL]; d2[]: END; 

5 «> BEGIN CO[qDUP]; C0[qOBL]; CO[qDBL]; MCO[qADD, cmin]; d2[]; END; 

6 => BEGIN CO[qDBL]; CO[qDUP]; CO[qDBL]; MCO[qADD, cmin]; d2[]; END; 
ENDCASE «> 

BEGIN 

[powerof2, log] ♦- log2[L00PH0LE[bp[l]]]; 

IF powerof2 THEN 

BEGIN LoadConstant[log]; CO[qSHIFT]; d2[]; END 
ELSE GO TO Slide; 
END; 
END; 
ENDCASE »> GO TO Slide; 
EXITS 

Slide => canSlide ^ TRUE; 
END; 
ENDCASE => canSlide <- FALSE; -- of WITH 
ENDLOOP; 
END; -- of OPEN state 
RETURN 
END; 

log2: PROCEDURE [i: INTEGER] RETURNS [BOOLEAN, CARDINAL] - 
BEGIN OPEN InlineDefs; 
shift: CARDINAL; 

IF i = THEN RETURN [FALSE. 0]; 

i <- ABS[i]; 

IF BITAND[i. i-1] # THEN RETURN [FALSE, 0]; 

FOR shift IN [0..16) DO 

IF BITAND[i,l] = 1 THEN RETURN[TRUE. shift]; 

i <- BITSHIFT[i, -1]; 

ENDLOOP 
END; 

cpeep7: PROCEDURE = 

BEGIN -- find special jumps 
OPEN FOpCodes; 
next: JumpCCIndex; 
jstate: JumpPeepState; 

next *- LOOPHOLE[start]; 
BEGIN OPEN jstate; 
UNTIL (c <- next) = CCNull DO 
next ^ LOOPHOLE[cb[c].flink]; 
WITH cb[LOOPHOLE[c,CCIndex]] SELECT FROM 
jump => 
BEGIN 

In itJParametersBC[@ jstate]; 
CPtr.codeptr <- c; 
SELECT jtype FROM 
JumpE «> 

IF binst = qLI THEN 

IF bp[l] = THEN BEGIN jtype *- ZJumpE; deletecen[b] END; 
JumpN => 

IF binst « qLI THEN 

IF bp[l] « THEN BEGIN jtype ^ ZJumpN; deletecel l[b] END; 
ENDCASE; 
END; 
ENDCASE; -- of WITH 
ENDLOOP: 
END; -- of OPEN state 
RETURN 
END; 
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END... 



